
module DemoMon where

import Orca.Language
import Orca.Prim

import Control.Monad

demo01 :: IO ()
demo01 = putStr $ orchestra $ do
    instr 101 $ fmBell (tableIx 1)


orchestra :: Orch () -> String
orchestra orch = 
    either error id $ compileOrch orch 

phasemod :: IKA_Signal ra => TableIx -> Sig ra -> Code ASig
phasemod itbl insig = do
    aphs    <- asignal $ phasor insig
    asig    <- asignal $ tablei_ aphs itbl 1 0 1
    return asig


ampenv_  :: KA_Signal a => IFloat -> GenSig a
ampenv_ idur = expseg 0.01 [ 0.002        ::: 1
                           , idur - 0.002 ::: 0.01
                           ]


-- Either carrier or modulator...
-- 
operator :: TableIx -> ASig -> Maybe (ASig -> ASig) -> Code ASig
operator itbl insig postpro = do 
    asig <-  phasemod itbl insig
    case postpro of 
       Nothing -> return ()
       Just fn -> asig =%= fn asig
    return asig

fmBell :: TableIx -> Instr
fmBell tb1 = definstr $ do
    isinetbl  <- defvar "isinetbl"  tb1 
    idur      <- defvar "idur"      (pfield 3 :: IFloat) 
    iamp      <- defvar "iamp"      (pfield 4 :: IFloat) 
    ifreq     <- defvar "ifreq"     (pfield 5 :: IFloat)
    indx      <- defvar "indx"      (pfield 6 :: IFloat)
    izout     <- defvar "izout"     (pfield 7)
    ifm1index <- defvar "ifm1index" (32.0 * ifreq)
    ifm2index <- defvar "ifm2index" (4.0 * (8.0 - ifreq / 50.0))
    ifm3index <- defvar "ifm3index" (ifm2index * 0.705 * (1.4 - ifreq / 250.0))
    ifm4index <- defvar "ifm4index" (32.0 * (20.0 - ifreq / 20.0))
    imod1freq <- defvar "imod1freq" (ifreq * 2.0)
    imod2freq <- defvar "imod2freq" (ifreq * 1.41)
    imod3freq <- defvar "imod3freq" (ifreq * 2.82)
    imod4freq <- defvar "imod4freq" (ifreq * 2.4)
    icar1freq <- defvar "icar1freq" (ifreq)
    icar2freq <- defvar "icar2freq" (ifreq)
    icar3freq <- defvar "icar3freq" (ifreq * 2.4)
    
    instbody $ do 
      let phasesig = operator isinetbl
    
      -- index envelope 
      kindxenv      <- ksignal $ expseg 1.0 [ idur ::: 0.1 ]

      -- amp envelope
      kampenv       <- ksignal $ ampenv_ idur

      -- modulator 1
      let amod1pp    = \asig -> (ifm1index *^ indx *^ kindxenv) .*. asig
      amod1sig      <- phasesig (signalA imod1freq) (Just amod1pp)

      -- carrier 1 
      acar1sig      <- phasesig (icar1freq +^ amod1sig) Nothing

      -- modulator 2
      amod2sig      <- phasesig (signalA imod2freq) Nothing

      -- modulator 3
      amod3sig      <- phasesig (signalA imod3freq) Nothing

      -- amod2sig now sums amod2sig and amod3sig
      amod2sig      =%= kindxenv .*. (ifm2index *^ amod2sig) 
                                 .+. (ifm3index *^ amod3sig)

      -- carrier 2
      acar2sig      <- phasesig (icar2freq +^ amod2sig) Nothing

      -- modulator 4
      let amod4pp   = \asig -> (ifm4index *^ indx *^ kindxenv) .*. asig
      amod4sig      <- phasesig (signalA imod4freq) (Just amod4pp)

      -- carrier 3
      acar3sig      <- phasesig (icar3freq +^ amod4sig) Nothing

      let aout      = ((iamp *^ kampenv) .*. (acar1sig .+. (0.15 *^ acar2sig) 
                                                       .+. (0.15 *^ acar3sig)))

      zaw aout izout

